Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / budget.arc / INCOME.BAS (.txt) < prev next >

Wrap

GW-BASIC | 1985-06-26 | 8.6 KB | 344 lines

10 REM ///// INCOME AVERAGING ///// 20 REM CLEAR SCREEN 30 CLS 40 KEY OFF 50 PRINT SPC(32) 60 COLOR 1:PRINT "Income Averaging":COLOR 7 70 REM ROUNDOFF FUNCTION '70 REM ROUND OFF TO WHOLE DOLLARS 80 DEF FNR(X)=INT(100*X+0.5)/100 'DEF FNR (X)=INT(X+0.5) 90 PU$="$$###,###.##" 'PU$=" $$,###,###" 100 REM A() HOLDS SCHEDULE G AMOUNTS 110 REM B(), C() AND R() ARE FOR TAX RATE SCHEDULES 120 DIM A(46),B(4,16),C(4,16),R(4,16) 130 REM READ TAX RATE SCHEDULES 140 GOSUB 2970 150 REM CLEAR SCHEDULE G FOR NEXT TAXPAYER 160 FOR I=1 TO 46 170 A(I)=0 180 NEXT I 190 PRINT 200 PRINT "Enter taxpayer's name: "; 210 LINE INPUT; Z$ 220 PRINT 230 PRINT " Enter taxable year:"; 240 INPUT " ",A(1) 250 IF A(1)>1980 THEN 280 260 PRINT "This program is for the years 1981 and thereafter." 270 GOTO 220 280 PRINT 290 PRINT "Enter filing status ..." 300 PRINT " 1 for Single" 310 PRINT " 2 for Married/Joint" 320 PRINT " 3 for Married/Separate" 330 PRINT " 4 for Head of Household" 340 PRINT " 5 for Qualifying Widow(er)" 350 INPUT " "; F 360 IF F<1 OR F>5 THEN PRINT "Please, 1 through 5 only.":GOTO 280 370 PRINT 380 REM 390 REM **** BASE PERIOD INCOME AND ADJUSTMENTS **** 400 REM 410 REM ENTER INCOME AMOUNTS-- 420 PRINT "Enter the amount from:" 430 PRINT " Form 1040--line 34" 440 PRINT " Form 1040A (1977 and 1978)--line 10" 450 PRINT " Form 1040A (1979 and 1980)--line 11" 460 PRINT 470 FOR J=1 TO 4 480 PRINT "for"; A(1)-J; 490 INPUT ;""; A(J+1) 500 PRINT TAB(21) 510 PRINT "How many exemptions were claimed"; 520 INPUT B 530 REM EXEMPTIONS ARE $1000 EACH 1979 & AFTER, $750 EACH BEFORE 1979 540 A(J+5)=1000*B 550 IF A(1)-J>1978 THEN 570 560 A(J+5)=750*B 570 A(J+9)=A(J+1)-A(J+5) 580 NEXT J 590 PRINT 600 PRINT "Most taxpayers don't have excluded foreign income," 610 PRINT " amounts subject to a penalty under section 72(m)(5)," 620 PRINT " or excess community income." 630 PRINT "Do you have any of these items (Y/N)"; 640 INPUT W$ 650 PRINT 660 IF W$="N" OR W$="n" THEN 790 670 FOR I=1 TO 4 680 PRINT "Excluded foreign income for"; A(1)-I; 690 INPUT A(15+I) 700 IF A(15+I)<0 THEN PRINT "Can not be less than zero.":GOTO 680 710 NEXT 720 PRINT 730 PRINT "Enter amounts subject to penalty, section 72(m)(5)"; 740 INPUT A(20) 750 PRINT SPC(21)"Enter excess community income"; 760 INPUT A(21) 770 PRINT 780 REM ADD UP BASE PERIOD INCOME COLUMNS (a) THROUGH (d) 790 A(22)=A(10)+A(16) 800 A(23)=A(11)+A(17) 810 A(24)=A(12)+A(18) 820 A(25)=A(13)+A(19) 830 REM BASE PERIOD INCOME CANNOT BE NEGATIVE 840 FOR I=22 TO 25 850 IF A(I)>0 THEN 870 860 A(I)=0 870 NEXT I 880 REM 890 REM **** COMPUTATION OF AVERAGABLE INCOME **** 900 REM 910 REM 6. TAXABLE INCOME FROM FORM 1040, LINE 34 920 PRINT "Enter taxable income for"; A(1); 930 INPUT A(26) 940 PRINT 950 REM 8. SUBTRACT LINE 7 FROM LINE 6 960 A(27)=A(26)-A(20) 970 REM 9. EXCESS COMMUNITY INCOME IS A(21) 980 REM 10. ADJUSTED TAXABLE INCOME 990 A(28)=A(27)-A(21) 1000 REM LINE 10 CANNOT BE NEGATIVE 1010 IF A(28)>=0 THEN 1040 1020 A(28)=0 1030 REM 11. TOTAL BASE PERIOD INCOME 1040 A(29)=A(22)+A(23)+A(24)+A(25) 1050 REM 12. 30% OF LINE 11 1060 A(30)=FNR(A(29)*0.3) 1070 REM 13. AVERAGEABLE INCOME 1080 A(31)=A(28)-A(30) 1090 IF A(31)>3000 THEN 1210 1100 PRINT Z$; 1110 PRINT " does NOT qualify for averaging." 1120 PRINT "Averageable income for"; A(1); "is "; 1130 PRINT USING "$$#,###"; A(31);:PRINT "," 1140 PRINT SPC(22)"which is $3,000 or less." 1150 PRINT 1160 GOTO 2420 1170 REM 1180 REM **** COMPUTATION OF TAX **** 1190 REM 1200 REM 14. AMOUNT FROM LINE 12 1210 A(32)=A(30) 1220 REM 15. 20% OF LINE 13 1230 A(33)=FNR(A(31)*0.2) 1240 REM 16. TOTAL (ADD LINES 14 AND 15) 1250 A(34)=A(32)+A(33) 1260 REM 17. EXCESS COMMUNITY INCOME IS A(21) 1270 REM 18. TOTAL (ADD LINES 16 AND 17) 1280 A(35)=A(34)+A(21) 1290 REM 19. TAX ON LINE 18 AMOUNT 1300 S=A(35) 1310 GOSUB 2660 1320 A(36)=T 1330 REM 20. TAX ON LINE 16 AMOUNT 1340 S=A(34) 1350 GOSUB 2660 1360 A(37)=T 1370 REM 21. TAX ON LINE 14 AMOUNT 1380 S=A(32) 1390 GOSUB 2660 1400 A(38)=T 1410 REM 22. SUBTRACT LINE 21 FROM LINE 20 1420 A(39)=A(37)-A(38) 1430 REM 23. MULTIPLY LINE 22 AMOUNT BY 4 1440 A(40)=4*A(39) 1450 REM IF NO SECTION 72(m)(5) PENALTY INCOME, SKIP TO LINE 28 1460 IF A(20)=0 THEN 1580 1470 REM 24. TAX ON LINE 6 AMOUNT 1480 S=A(26) 1490 GOSUB 2660 1500 A(41)=T 1510 REM 25. TAX ON LINE 8 AMOUNT 1520 S=A(27) 1530 GOSUB 2660 1540 A(42)=T 1550 REM 26. SUBTRACT LINE 25 FROM LINE 24 1560 A(43)=A(41)-A(42) 1570 REM 27. ADD LINES 19, 23 AND 26 1580 A(44)=A(36)+A(40)+A(43) 1590 REM 28. MULTIPLY LINE 27 BY .0125 1600 A(45)=A(44)*0.0125 1610 REM 29. TAX (SUBTRACT LINE 28 FROM LINE 27) 1620 A(46)=A(44)-A(45) 1630 REM 1640 REM **** PRINT SCHEDULE G **** 1650 REM 1660 PRINT "For ";Z$;". the tax for";A(1); 1670 PRINT "using income averaging," 1680 PRINT "comes to"; : PRINT USING PU$; A(46) 1690 PRINT "THE FOLLOWING REPRESENTS THE FILLED-IN"; 1700 PRINT " SCHEDULE G USING THE 1981 FORMAT:" 1710 PRINT 1720 PRINT " SCHEDULE G"SPC(17)"Income Averaging"SPC(22) A(1) 1730 PRINT Z$;TAB(31) 1740 PRINT "Filing status: "; 1750 ON F GOTO 1760,1780,1800,1820,1840 1760 PRINT "Single" 1770 GOTO 1850 1780 PRINT "Married/Joint" 1790 GOTO 1850 1800 PRINT "Married/Separate" 1810 GOTO 1850 1820 PRINT "Unmarried Head of Household" 1830 GOTO 1850 1840 PRINT "Qualifying Widow(er)" 1850 PRINT "Base Period"; 1860 PRINT SPC(20)"(a)"SPC(9)"(b)"SPC(9)"(c)"SPC(9)"(d)" 1870 PRINT "Income and Adjustments "; 1880 FOR I=1 TO 4 1890 PRINT SP(6) A(1)-I; 1900 NEXT 1910 PRINT 1920 REM PRINT LINE 1 1930 I=2:J=1 1940 GOSUB 2490 1950 REM PRINT LINES 2a AND 2b 1960 PRINT "Line 2a"TAB(24) 1970 FOR J=1 TO 4 1980 IF A(1)-J<1979 THEN PRINT USING PU$; A(5+J); ELSE PRINT SPC(12) 1990 NEXT 2000 PRINT 2010 PRINT "Line 2b"TAB(24) 2020 FOR J=1 TO 4 2030 IF A(1)-J>1978 THEN PRINT USING PU$; A(5+J); ELSE PRINT SPC(12) 2040 NEXT 2050 PRINT 2060 REM PRINT LINE 3 2070 I=10:J=3 2080 GOSUB 2490 2090 REM PRINT LINE 4 2100 I=16:J=4 2110 GOSUB 2490 2120 REM PRINT LINE 5 2130 I=22:J=5 2140 GOSUB 2490 2150 PRINT "Computation of Averageable Income" 2160 PRINT "Line 6"TAB(60):PRINT USING PU$; A(26) 2170 PRINT "Line 7"TAB(60):PRINT USING PU$; A(20) 2180 PRINT "Line 8"TAB(60):PRINT USING PU$; A(27) 2190 PRINT "Line 9"TAB(60):PRINT USING PU$; A(21) 2200 FOR J=10 TO 13 2210 PRINT "Line";J; 2220 IF J=11 THEN PRINT TAB(48) ELSE PRINT TAB(60) 2230 PRINT USING PU$; A(J+18) 2240 NEXT J 2250 REM WAIT FOR OPERATOR CUE TO CONTINUE 2260 GOSUB 2590 2270 PRINT "Computation of Tax" 2280 FOR J=14 TO 16 2290 PRINT "Line";J;TAB(60):PRINT USING PU$; A(J+18) 2300 NEXT J 2310 PRINT "Line 17"TAB(60):PRINT USING PU$; A(21) 2320 FOR J=18 TO 29 2330 PRINT "Line";J; 2340 IF J>19 AND J<23 OR J=24 OR J=25 THEN PRINT TAB(48):GOTO 2360 2350 PRINT TAB(60) 2360 PRINT USING PU$; A(J+17) 2370 NEXT J 2380 PRINT 2390 PRINT STRING$(26,"*")" END OF SCHEDULE G "STRING$(26,"*") 2400 PRINT 2410 REM WAIT BEFORE ERASING SCREEN FOR NEXT TAXPAYER 2420 PRINT "Enter 'C' to continue with next taxpayer. "; 2430 INPUT "",W$ 2440 IF W$="C" OR W$="c" THEN CLS:GOTO 160 2450 END 2460 REM 2470 REM *** SUBROUTINE TO PRINT ALL OF LINE 1,3,4 OR 5 *** 2480 REM 2490 PRINT "Line "; J; TAB(24) 2500 FOR J=0 TO 3 2510 PRINT USING PU$; A(I+J); 2520 NEXT J 2530 PRINT 2540 RETURN 2550 REM 2560 REM *** SUBROUTINE TO WAIT FOR OPERATOR CUE TO CONTINUE 2570 REM SINCE ENTIRE SCHEDULE G DOESN'T FIT ON ONE SCREEN *** 2580 REM 2590 PRINT "Press [RETURN] to continue. "; 2600 INPUT "",W$ 2610 RETURN 2620 REM 2630 REM *** SUBROUTINE TO CALCULATE TAX ON AMOUNT S *** 2640 REM 2650 REM INITIALIZE TAX TO ZERO 2660 T=0 2670 REM SINGLE HAS 16 BRACKETS, ALL OTHERS HAVE 15 2680 K=15 2690 IF F>1 THEN 2720 2700 K=16 2710 REM DETERMINE WHETHER TO USE SCHEDULE X, Y OR Z 2720 I=F 2730 REM WIDOW(ER) SAME AS MARRIED/JOINT 2740 IF F<5 THEN 2770 2750 I=2 2760 REM START WITH ZERP BRACLET A,PIMT 2770 J=1 2780 REM IS INCOME <= ZERO BRACKET AMOUNT? 2790 IF S<=C(I,J) THEN 2920 2800 REM IS INCOME > THIS BRACKET'S CEILING? 2810 IF S>C(I,J+1) THEN 2870 2820 REM FOUND PROPER TAX BRACKET-- 2830 REM --COMPUT TAX ON BALANCE OF INCOME 2840 T=(S-C(I,J))*R(I,J)/100+B(I,J) 2850 GOTO 2920 2860 REM PROCEED TO NEXT BRACKET 2870 J=J+1 2880 IF J<K THEN 2810 2890 REM TAX ON BALANCE OF INCOME IS AT HIGHEST RATE 2900 GOTO 2840 2910 REM ROUND TAX AMOUNT 2920 T=FNR(T) 2930 RETURN 2940 REM 2950 REM *** SUBROUTINE TO READ TAX RATES *** 2960 REM 2970 RESTORE 2980 REM FIRST SCHEDULE X 2990 FOR J=1 TO 16 3000 READ B(1,J),R(1,J),C(1,J) 3010 NEXT J 3020 REM THEN SCHEDULES Y & Z 3030 FOR I=2 TO 4 3040 FOR J=1 TO 15 3050 READ B(I,J),R(I,J),C(I,J) 3060 NEXT J 3070 NEXT I 3080 RETURN 3090 REM 3100 REM ***** 1979 TAX RATE SCHEDULES X, Y AND Z ***** 3110 REM 3120 REM FOR EACH TABLE BELOW, GET BASE, RATE AND 3130 REM CUTOFF DATA TRIPLET FROM THE RIGHTMOST THREE 3140 REM COLUMNS OF THE APPROPRIATE SCHEDULE 3150 REM 3160 REM ----SCHEDULE X (SINGLE TAXPAYERS)---- 3170 REM 3180 DATA 0,14,2300,154,16,3400,314,18,4400,692,19,6500,1072,21,8500 3190 DATA 1555,24,10800,2059,26,12900,2605,30,15000,3565,34,18200 3200 DATA 5367,39,23500,7434,44,28800,9766,49,34100,13392,55,41500 3210 DATA 20982,63,55300,37677,68,81800,55697,70,108300 3220 REM 3230 REM ----SCHEDULE Y (JOINT/WIDOW)---- 3240 REM 3250 DATA 0,14,3400,294,16,5500,630,18,7600,1404,21,11900,2265,24,16000 3260 DATA 3273,28,20200,4505,32,24600,6201,37,29900,8162,43,35200,12720 3270 DATA 49,45800,19678,54,60000,33502,59,85600,47544,64,109400 3280 DATA 81464,68,162400,117504,70,215400 3290 REM 3300 REM ----SCHEDULE Y (SEPARATE)---- 3310 REM 3320 DATA 0,14,1700,147,16,2750,315,18,3800,702,21,5950,1132.50,24,8000 3330 DATA 1636.50,28,10100,2252.50,32,12300,3100.50,37,14950,4081,43 3340 DATA 17600,6360,49,22900,9839,54,30000,16751,59,42800,23772,64 3350 DATA 54700,40732,68,81200,58752,70,107700 3360 REM 3370 REM ----SCHEDULE Z (UNMARRIED HEAD OF HOUSEHOLD)---- 3380 REM 3390 DATA 0,14,2300,294,16,4400,630,18,6500,1026,22,8700,1708,24,11800 3400 DATA 2476,26,15000,3308,31,18200,4951,36,23500,6859,42,28800,9085 3410 DATA 46,34100,13961,54,44700,22547,59,60600,35055,63,81800,51750 3420 DATA 68,108300,87790,70,161300 3430 END